module FuzzyCMeans where

--import CommonTypes
import System.Random
import GSL.LinearAlgebra
import GSL.LinearAlgebra.Vector
import GSL.LinearAlgebra.Matrix
import GSL.LinearAlgebra.Algorithms

--linearComb :: Num a => [a] -> [[a]] -> [a]
--linearComb coeffs vectors = map (scal coeffs) (transpose vectors)
	
power :: Double -> Double -> Double
power base pow = exp ((log base) * pow)

--vMap :: (Field a, Field b) => (a -> b) -> Vector a -> Vector b
--vMap f v = fromList $ map f (toList v)

vSum :: (Field a, Num a) => Vector a -> a
vSum = sum . toList

--mMap :: (Field a, Field b) => (a->b) -> Matrix a -> Matrix b
--mMap f m = fromRows $ map (\v -> vMap f v) (toRows m)

mSum :: Matrix Double ->  Double
mSum m = sum $ map (vSum) (toRows m)
--doFuzzyKMeansAddCluster :: RandomGen g => g -> FuzzyClustering a -> Double -> FuzzyClusteringAlgorithm a
--doFuzzyKMeansAddCluster gen clustering q dist 

euclNorm :: Vector Double -> Double 
euclNorm = en . toList where
	en = sum . (map (^2))

generateRandomMembership :: RandomGen g => g -> Int -> (Vector Double, g)
generateRandomMembership g s = convert $ gm [] 1 g s where
	gm :: RandomGen g => [Double] -> Double -> g -> Int -> ([Double], g)
	gm result _ gen 0 = (result, gen)
	gm result 0 gen size = (result ++ (replicate size 0), gen)
	gm result top gen 1 = (result ++ [top], gen)
	gm result top gen size = let (newVal, newGen) = randomR (0, top) gen in
		gm (result ++ [newVal]) (top - newVal) newGen (size-1)
	convert (ls, g) = (fromList ls, g)	

generateRandomMemberships :: RandomGen g => g -> Int -> Int -> (Matrix Double, g)
generateRandomMemberships g s n = convert $ gm [] g s n where
	gm result gen _ 0 = (result, gen)
	gm result gen size i = let (newV, newGen) = generateRandomMembership gen size in
		gm (result ++ [newV]) newGen size (i-1)
	convert (ls, g) = (fromRows ls, g)

doGenerateRandomMemberships = do
	gen <- getStdGen
	let m = fst $ generateRandomMemberships gen 1 1
	print m


-- calculate memberships of a vector set for a cluster

type DistanceFunction a = a -> a -> Double

-- membership of a vector v to the clusters defined by their centroids.
type MembershipFunction = Double -> Matrix Double -> Matrix Double

data FuzzyCMeansParams a = FuzzyCMeansParams { 
	fuzzifier :: Double, 

	-- fuzzifier, distance matrix -> membership matrix
	membership :: MembershipFunction, 

	epsilon :: Double,
	
	-- fuzzifier, membership matrix, distances matrix -> objective function value
	targetFunction :: Double -> Matrix Double -> Matrix Double -> Double,

	-- fuzzifier, membership  matrix, data vectors -> centroids
	centroidsFunction :: Double -> Matrix Double -> [Vector Double] -> [Vector Double],

	distance :: a -> a -> Double }
	

data ClusteringResults = ClusteringResults {
	centroids :: [Vector Double],
	vectors :: [Vector Double],
	memberships :: Matrix Double
}

instance Show ClusteringResults where
	show r = "Centroids: \n" ++ (showArr $ centroids r) ++
		"\n\n Memberships:\n" ++ (showArr $ toRows $ memberships r) where
		showVector = show . toList
		showArr arr = foldl1 (++) (map (\x -> showVector x ++ "\n") arr)

componentsDistance :: (Double->Double->Double) -> DistanceFunction (Vector Double)
componentsDistance f v1 v2 = cd 0 (toList v1) (toList v2) where
	cd result [] _ = result
	cd result _ [] = result
	cd result (vh1:vt1) (vh2:vt2) = cd (result + (f vh1 vh2)) vt1 vt2

--bhattacharyaDistance :: DistanceFunction (Vector Double)
--bhattacharyaDistance = componentsDistance (\x y -> sqrt (x*y))

klawonnDistance v1 v2 = 1 - (dot v1 v2)

{--v1 v2 = bd 0 (toList v1) (toList v2) where
	bd result [] _ = result
	bd result _ [] = result
	bd result (vh1:vt1) (vh2:vt2) = bd (result + (sqrt vh1*vh2)) vt1 vt2
--}

euclidsDistance :: DistanceFunction (Vector Double)
euclidsDistance = componentsDistance (\x y -> (x-y)^2)
{--v1 v2 = ed 0 (toList v1) (toList v2) where
	ed reuslt [] _ = result
	ed result _ [] = result
	ed result (vh1:vt1) (vh2:vt2) = ed (result + (vh1-vh2)^2) vt1 vt2
--}

calculateVectorDistance :: DistanceFunction a -> [a] -> a -> Vector Double
calculateVectorDistance dist centroids v = fromList $ map (\c -> dist c v) centroids

calculateDistances :: DistanceFunction a -> [a] -> [a] -> Matrix Double
calculateDistances dist centroids vs = 
	fromRows $ map (calculateVectorDistance dist centroids) vs 


-- Classic fuzzy membership of a vector v to the clusters defined by their centroids.
classicMembership :: MembershipFunction
classicMembership fuzz distances = fromRows $ map m (toRows distances) where
			m :: Vector Double -> Vector Double
			m ds = gmap (\d -> 1 / (vSum $ gmap (\x -> (power (d/x) (2/(fuzz-1::Double)))) ds)) ds

--klawonnMembership :: MembershipFunction
--klawonnMembership fuzz distances = 
--

-- Distances -> Memberships -> measure
classicTarget :: Double -> Matrix Double -> Matrix Double -> Double
classicTarget fuzz distances memberships = let 
	mems = gmap (\x -> power x fuzz) memberships; dists = trans $ gmap (^2) distances in
		mSum $ mXm mems dists


-- Each line in membership matrix corresponds to the domain vector
--calculateMemberships :: MembershipFunction (Vector a) -> Matrix Double -> Matrix Double
--calculateMemberships memf centers vs = fromRows $ map (cvm (toRows centers)) vs where
--	cvm :: Vector 

scalar :: Double -> Vector Double -> Vector Double
scalar c v = gmap (*c) v

-- Centroids from the membership matrix
--calculateCentroids :: Double -> Matrix Double -> [Vector Double] -> [Vector Double]
--calculateCentroids fuzz mx vs = map center (toColumns mx) where
--	center :: Vector Double -> Vector Double
--	center col = let vsMx = fromRows vs; coeffs = gmap (\x -> power x fuzz) col in
--		scalar ((1::Double) / (vSum coeffs)) (vXm coeffs vsMx)

calculateCentroids :: Double -> Matrix Double -> [Vector Double] -> [Vector Double]
calculateCentroids fuzz mx vs = let mulMx = mXm (fromColumns vs) (gmap (\x -> power x fuzz) mx) in
		map kpr (toColumns mulMx) where
	kpr :: Vector Double -> Vector Double
	kpr v = let d = vSum v in gmap (/d) v

fuzzyCMeans :: RandomGen g => g -> FuzzyCMeansParams (Vector Double) -> Int -> [Vector Double] -> ClusteringResults
fuzzyCMeans g params c vs = fcm 0 (fst $ generateRandomMemberships g c (length vs)) where
	fcm :: Double -> Matrix Double -> ClusteringResults
	fcm prevResult mems = let { 
			fuzz = fuzzifier params;
			newCentroids = (centroidsFunction params) fuzz mems vs;
			dists = calculateDistances (distance params) newCentroids vs;
			newMemberships = (membership params) fuzz dists;
			tf = targetFunction params;
			newTarget = tf fuzz dists newMemberships } in
		if ((abs (newTarget - prevResult)) < (epsilon params)) then ClusteringResults newCentroids vs newMemberships
		else fcm newTarget newMemberships

prepareData :: [[Double]] -> [Vector Double]
prepareData = map fromList


doKlawonnFuzzyCMeans = do
	gen <- getStdGen
	let params = FuzzyCMeansParams 1.5 classicMembership 0.0001 classicTarget calculateCentroids klawonnDistance
	let result = fuzzyCMeans gen params 4 (prepareData [[1,0], [0,1], [0.9, 0.1], [0.1, 0.9], [0.6,0.4], [0.0001,0.9999], [0.4,0.6]])
	print result 

doFuzzyCMeans = do
	gen <- getStdGen
	let params = FuzzyCMeansParams 1.5 classicMembership 0.1 classicTarget calculateCentroids euclidsDistance
	let result = fuzzyCMeans gen params 4 [fromList [1], fromList [0.98], fromList [1.01], fromList [2], fromList [2.1], fromList [3], fromList [3.3], fromList [2.5]]
	print result

--fuzzyKMeans :: Double -> DistanceFunction a -> MembershipFunction a -> 
